home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
STREAM13.ARJ
/
XMSSTRM.INC
< prev
Wrap
Text File
|
1992-05-05
|
10KB
|
363 lines
{ This include file is a slightly modified version of XMSSTRM.PAS, by Stefan
Boether, included here with his kind permission. -djm }
(*****************************************************************************)
(* *)
(* Filename : XMSSTRM.INC *)
(* Autor : Stefan Boether / Compuserve Id : 100023,275 *)
(* System : TURBO 6.00 / MS-DOS 3.2 / Netzwerk *)
(* Aenderung : *)
(* wann was wer *)
(*---------------------------------------------------------------------------*)
(* 22.03.92 Error fixed with NewBlock and UsedBlocks Stefc *)
(* 28.04.92 Size field added, BlockSize made constant DJM *)
(*****************************************************************************)
(* Beschreibung: Object for an Stream in XMS-Memory *)
(*****************************************************************************)
{Header-End}
{!!!!!!!!!!!!!!!
program Test;
uses objects, XmsStrm;
var T : TXmsStream;
P : PString;
begin
writeln( xms_MaxAvail, ' ', xms_MemAvail );
T.Init( 20 );
T.WriteStr( NewStr( 'Hello' ));
T.WriteStr( NewStr( 'World' ));
T.Seek( 0 );
P := T.ReadStr;
writeln( P^ );
P := T.ReadStr;
writeln( P^ );
T.Done;
end.
!!!!!!!!!!!!!!!!}
var xms_IOsts : Byte;
xms_Addr : Pointer;
const
xms_Initialized : Boolean = False;
{ This allows us to avoid a unit initialization section }
xms_BlockSize = 1024;
{ - Some Xms - Procedures that I need ! -}
(* /////////////////////////////////////////////////////////////////////// *)
procedure MoveMem(ToAddress : Pointer; ToHandle : Word;
FromAddress : Pointer; FromHandle : Word;
Size : LongInt);
begin
asm
mov ah,$0B
lea si,Size
push ds
pop es
push ss
pop ds
call es:[xms_Addr]
push es
pop ds
or ax,ax
jnz @@1
mov byte ptr xms_IOsts,bl
@@1:
end;
end;
(* /////////////////////////////////////////////////////////////////////// *)
function GetByte(Handle : Word; FromAddress : LongInt) : Byte;
var TempBuf : array[0..1] of Byte;
begin
MoveMem(@TempBuf, 0, Pointer(FromAddress and $FFFFFFFE), Handle, 2);
GetByte := TempBuf[FromAddress and $00000001];
end;
(* /////////////////////////////////////////////////////////////////////// *)
procedure SetByte(Handle : Word; ToAddress : LongInt; Value : Byte);
var TempBuf : array[0..1] of Byte;
begin
MoveMem(@TempBuf, 0, Pointer(ToAddress and $FFFFFFFE), Handle, 2);
TempBuf[ToAddress and $00000001] := Value;
MoveMem(Pointer(ToAddress and $FFFFFFFE), Handle, @TempBuf, 0, 2);
end;
(* /////////////////////////////////////////////////////////////////////// *)
procedure xms_Init;
begin
if not xms_Initialized then
begin
xms_IOsts := 0;
xms_Addr := nil;
asm
mov ax,$4300
int $2F
cmp al,$80
jne @@1
mov ax,$4310
int $2F
mov word ptr xms_Addr,bx
mov word ptr xms_Addr+2,es
jmp @@2
@@1:
mov byte ptr xms_IOsts,$80
@@2:
end;
if xms_IOsts = 0 then
xms_Initialized := True;
end;
end;
(* /////////////////////////////////////////////////////////////////////// *)
function xms_GetMem(KB : Word) : Word; Assembler;
asm
mov ah,$09
mov dx,word ptr KB
call [xms_Addr]
or ax,ax
jz @@1
mov ax,dx
jmp @@2
@@1:
mov byte ptr xms_IOsts,bl
@@2:
end;
(* /////////////////////////////////////////////////////////////////////// *)
procedure xms_FreeMem(Handle : Word);
begin
asm
mov ah,$0A
mov dx,word ptr Handle
call [xms_Addr]
or ax,ax
jnz @@1
mov byte ptr xms_IOsts,bl
@@1:
end;
end;
(* /////////////////////////////////////////////////////////////////////// *)
procedure xms_ResizeMem(Size, Handle : Word);
begin
asm
mov ah,$0F
mov bx,word ptr Size
mov dx,word ptr Handle
call [xms_Addr]
or ax,ax
jnz @@1
mov byte ptr xms_IOsts,bl
@@1:
end;
end;
(* /////////////////////////////////////////////////////////////////////// *)
procedure xms_MoveFrom(Size, Handle : Word; FromAddress : LongInt;
ToAddress : Pointer);
type ByteArr = array[0..MaxInt] of Byte;
BytePtr = ^ByteArr;
begin
if Size = 0 then Exit;
if Odd(FromAddress) then begin
BytePtr(ToAddress)^[0] := GetByte(Handle, FromAddress);
if xms_IOsts <> 0 then Exit;
Dec(Size);
Inc(FromAddress);
Inc(LongInt(ToAddress));
end;
MoveMem(ToAddress, 0, Pointer(FromAddress), Handle, Size and $FFFE);
if xms_IOsts <> 0 then Exit;
if Odd(Size)
then BytePtr(ToAddress)^[Size-1] := GetByte(Handle, FromAddress+Size-1);
if xms_IOsts <> 0 then Exit;
end;
(* /////////////////////////////////////////////////////////////////////// *)
procedure xms_MoveTo(Size, Handle : Word; FromAddress : Pointer;
ToAddress : LongInt);
type ByteArr = array[0..MaxInt] of Byte;
BytePtr = ^ByteArr;
begin
if Size = 0 then Exit;
if Odd(ToAddress) then begin
SetByte(Handle, ToAddress, BytePtr(FromAddress)^[0]);
if xms_IOsts <> 0 then Exit;
Dec(Size);
Inc(LongInt(FromAddress));
Inc(ToAddress);
end;
MoveMem(Pointer(ToAddress), Handle, FromAddress, 0, Size and $FFFE);
if xms_IOsts <> 0 then Exit;
if Odd(Size)
then SetByte(Handle, ToAddress+Size-1, BytePtr(FromAddress)^[Size-1]);
if xms_IOsts <> 0 then Exit;
end;
(* /////////////////////////////////////////////////////////////////////// *)
constructor TXMSStream.Init(AMaxBlocks : Word);
begin
TStream.Init;
xms_Init;
MaxBlocks := AMaxBlocks;
BlocksUsed := 0;
Size := 0;
Position := 0;
Handle := 0;
if xms_IOsts <> $00 then
Error(stInitError, xms_IOsts)
else
begin
Handle := xms_GetMem(1);
if xms_IOsts <> $00 then
Error(stInitError, xms_IOsts)
else
BlocksUsed := 1;
end;
end;
function TXMSStream.GetPos : LongInt;
begin
GetPos := Position;
end;
function TXMSStream.GetSize : LongInt;
begin
GetSize := Size;
end;
procedure TXMSStream.Read(var Buf; Count : Word);
begin
if Status = stOK then
if Position+Count > Size then
Error(stReaderror, 0)
else
begin
xms_MoveFrom(Count, Handle, Position, @Buf);
if xms_IOsts <> 0 then
Error(stReaderror, xms_IOsts)
else
Inc(Position, Count);
end;
end;
procedure TXMSStream.Seek(Pos : LongInt);
begin
if Status = stOK then
if Pos >= Size then
Error(stReaderror, Pos)
else
Position := Pos;
end;
procedure TXMSStream.Truncate;
begin
if Status = stOK then
begin
Size := Position;
while (BlocksUsed > (Size div xms_BlockSize+1)) do FreeBlock;
end;
end;
procedure TXMSStream.Write(var Buf; Count : Word);
begin
while (Status = stOK)
and (Position+Count >= LongMul(xms_BlockSize, BlocksUsed)) do
NewBlock;
if Status = stOK then
begin
xms_MoveTo(Count, Handle, @Buf, Position);
if xms_IOsts <> 0 then
Error(stWriteError, xms_IOsts)
else
Inc(Position, Count);
if Position > Size then
Size := Position;
end;
end;
procedure TXMSStream.NewBlock;
begin
if Succ(BlocksUsed) > MaxBlocks then
Error(stWriteError, stUsedAll)
else
begin
xms_ResizeMem(Succ(BlocksUsed), Handle);
if xms_IOsts <> 0 then
Error(stWriteError, xms_IOsts)
else
Inc(BlocksUsed);
end;
end;
procedure TXMSStream.FreeBlock;
begin
Dec(BlocksUsed);
xms_ResizeMem(BlocksUsed, Handle);
end;
function xms_MaxAvail : Word;
begin
xms_Init;
if xms_IOsts = 0 then
asm
mov ah,$08
call [xms_Addr]
mov @result,ax
or ax,ax
jnz @@1
mov byte ptr xms_IOsts,bl
@@1:
end
else
xms_MaxAvail := 0;
end;
(* /////////////////////////////////////////////////////////////////////// *)
function xms_MemAvail : Word;
begin
xms_Init;
if xms_IOsts = 0 then
asm
mov ah,$08
call [xms_Addr]
or ax,ax
jz @@1
mov @result,dx
jmp @@2
@@1:
mov byte ptr xms_IOsts,bl
@@2:
end
else
xms_MemAvail := 0;
end;
destructor TXMSStream.Done;
begin
Seek(0);
Truncate;
if xms_Initialized then
xms_FreeMem(Handle);
end;